home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 10 - 1994 / 10.03 Mar 94 / StackTranslators / StackTranslatorComponent.p < prev    next >
Encoding:
Text File  |  1994-02-15  |  10.5 KB  |  297 lines  |  [TEXT/MPS ]
  1. UNIT StackBasedStackTranslator;
  2. {$N+}
  3. {$R-}
  4. {$D-}
  5. INTERFACE
  6.  
  7. USES Types, Memory, Files, Resources, Errors, Packages, AppleEvents, ASRegistry, OSA, Components, GestaltEqu, SysEqu;
  8.  
  9. FUNCTION  TranslatorComponent(VAR params: ComponentParameters;
  10.                storage: Handle): ComponentResult;
  11.  
  12. IMPLEMENTATION
  13.  
  14. TYPE StorageHandle = ^StoragePtr; { Our private storage }
  15.      StoragePtr = ^StorageRecord;
  16.      StorageRecord = RECORD      
  17.        self: ComponentInstance;   { We don't need much }
  18.      END;
  19.      HandlePtr = ^Handle;
  20.  
  21. CONST kComponentVersion = $01000100; { Our version number }
  22.       kTranslateStack = 0; { our stack translation component selector}
  23.  
  24. { Forward declarations for our private routines. }
  25. FUNCTION  DoTranslatorCanDo(selector: INTEGER):
  26.                     ComponentResult; FORWARD;  
  27. FUNCTION  DoTranslatorClose(storageHndl: Handle;
  28.            self: ComponentInstance): ComponentResult; FORWARD;
  29. FUNCTION  DoTranslatorOpen(self: ComponentInstance):
  30.                     ComponentResult; FORWARD;
  31. FUNCTION  DoTranslatorRegister: ComponentResult; FORWARD;
  32. FUNCTION  DoTranslateStack(storageHndl: StorageHandle;
  33.            componentSubType: OSType;
  34.            stackFile: INTEGER;
  35.            stackResFile: INTEGER;
  36.            fileSpecPtr: FSSpecPtr): ComponentResult; FORWARD;
  37. FUNCTION  FRefToFSSpec(fRefNum: INTEGER;
  38.                     VAR spec: FSSpec): OSErr; FORWARD;
  39. PROCEDURE MyDisposeDesc(VAR desc: AEDesc); FORWARD;
  40. PROCEDURE MyDisposHandle(VAR hndl: Handle); FORWARD;
  41.  
  42. FUNCTION TranslatorComponent(VAR params: ComponentParameters;
  43.                  storage: Handle): ComponentResult;
  44. { The sole entrypoint for the component. }
  45. BEGIN
  46.   IF params.what < 0 THEN  { component manager values}
  47.     CASE params.what OF
  48.       kComponentRegisterSelect: TranslatorComponent :=
  49.                 CallComponentFunction(params,
  50.                 ComponentRoutine(@DoTranslatorRegister));
  51.       kComponentVersionSelect: TranslatorComponent := 
  52.                   kComponentVersion;
  53.       kComponentCanDoSelect: TranslatorComponent :=
  54.                 CallComponentFunction(params,
  55.                 ComponentRoutine(@DoTranslatorCanDo));
  56.       kComponentCloseSelect: TranslatorComponent :=
  57.                 CallComponentFunctionWithStorage(storage,params,
  58.                 ComponentRoutine(@DoTranslatorClose));
  59.       kComponentOpenSelect: TranslatorComponent :=
  60.                 CallComponentFunction(params,
  61.                 ComponentRoutine(@DoTranslatorOpen));
  62.       OTHERWISE
  63.         TranslatorComponent := badComponentSelector;
  64.     END
  65.   ELSE  { Our component-specific routines }
  66.     BEGIN
  67.       IF params.what = kTranslateStack
  68.       THEN TranslatorComponent :=
  69.                 CallComponentFunctionWithStorage(storage,
  70.                     params,ComponentRoutine(@DoTranslateStack))
  71.       ELSE TranslatorComponent := badComponentSelector;
  72.     END;
  73. END;
  74.  
  75. FUNCTION DoTranslatorCanDo(selector: INTEGER): ComponentResult;
  76. { Called  when the component is asked whether it supports a particular selector. }
  77. BEGIN
  78.   IF (selector >= kComponentRegisterSelect) 
  79.     & (selector <= kTranslateStack)
  80.   THEN DoTranslatorCanDo := 1   { valid request }
  81.   ELSE DoTranslatorCanDo := 0;  { invalid request }
  82. END;
  83.  
  84. FUNCTION DoTranslatorClose(storageHndl: Handle;
  85.               self: ComponentInstance): ComponentResult;
  86. {    Called when the component is closed.
  87.     We allocate global storage when we're opened, so we'll deallocate it here. }
  88. BEGIN
  89.   MyDisposHandle(storageHndl);
  90.   DoTranslatorClose := noErr;
  91. END;
  92.  
  93. FUNCTION DoTranslatorOpen(self:ComponentInstance):
  94.                         ComponentResult; 
  95. {    Called when the component is opened.
  96.      This component uses global storage, so we allocate it here. }
  97. VAR storageHndl: Handle;
  98. BEGIN
  99.   DoTranslatorOpen := noErr;
  100.   storageHndl := NewHandle(SizeOf(StorageRecord));
  101.   StorageHandle(storageHndl)^^.self := self;    { Remember it }
  102.   { Tell the Component Mgr to remember our storage handle. }
  103.   SetComponentInstanceStorage(self,storageHndl);
  104. END;
  105.  
  106. FUNCTION DoTranslatorRegister: ComponentResult;
  107. { Return FALSE if it's OK to register this component. }
  108. VAR theWorld:   SysEnvRec;
  109.     gestaltInfo: LongInt;
  110.     dummyResult: INTEGER;
  111.     registerOK: BOOLEAN;
  112. BEGIN
  113.   { this component needs System 7 and the Apple Event Manager. }
  114.   dummyResult := SysEnvirons(1,theWorld);
  115.   registerOK := (theWorld.systemVersion >= $0700)   { 7.x system }
  116.    & (Gestalt(gestaltAppleEventsAttr,gestaltInfo) = noErr)  
  117.    & BTST(gestaltInfo,gestaltAppleEventsPresent);{ AEM is present }
  118.   DoTranslatorRegister := ORD(NOT registerOK);
  119. END;
  120.  
  121. FUNCTION DoTranslateStack(storageHndl: StorageHandle;
  122.                      componentSubType: OSType;
  123.                      stackFile: INTEGER;
  124.                      stackResFile: INTEGER;
  125.                      fileSpecPtr: FSSpecPtr): ComponentResult;
  126. { Handles requests for translating stacks. }
  127. VAR thisComponent: Component;
  128.     saveTopMapHndl: Handle;
  129.     hyperPSN: ProcessSerialNumber;
  130.     addressDesc: AEDesc;
  131.     appleEvt: AppleEvent;
  132.     replyEvt: AppleEvent;
  133.     fileList: AEDescList;
  134.     paramList: AEDescList;
  135.     msgStr: Str255;
  136.     compFSSpec: FSSpec;
  137.     stackFSSpec: FSSpec;
  138.     compResFile: INTEGER;
  139.     result: OSErr;
  140.     ignoreResult: OSErr;
  141.  
  142.   PROCEDURE CleanExit;
  143.   { Dispose of everything we allocated before exiting. }
  144.   BEGIN
  145.     MyDisposeDesc(addressDesc);
  146.     MyDisposeDesc(appleEvt);
  147.     MyDisposeDesc(replyEvt);
  148.     MyDisposeDesc(fileList);
  149.     MyDisposeDesc(paramList);
  150.  
  151.     EXIT(DoTranslateStack);
  152.   END;
  153.  
  154.   PROCEDURE CheckError(err: LongInt);
  155.   { If an error occurred, set our return value and call CleanExit. } 
  156.   BEGIN
  157.     IF err <> noErr THEN 
  158.       BEGIN
  159.         DoTranslateStack := err;
  160.         CleanExit;
  161.       END
  162.   END;
  163.   
  164. BEGIN
  165.   DoTranslateStack := noErr;  { assume success }
  166.  
  167.   {    Set everything to nil now that we need to allocate later.  This will tell us on an
  168.     error exit what we've allocated and what we haven't. }
  169.   addressDesc.dataHandle := NIL;
  170.   appleEvt. dataHandle := NIL;
  171.   replyEvt.dataHandle := NIL;
  172.   fileList.dataHandle := NIL;
  173.   paramList.dataHandle := NIL;
  174.   
  175.      { Get FSSpec of stack to be translated. }
  176.   CheckError(FRefToFSSpec(stackFile,stackFSSpec));
  177.  
  178.      { Get FSSpec of the stack that contains the HyperTalk script; this is the same
  179.     as the FSSpec for the component resource file. }
  180.  
  181.     { Open the component's resource fork. }
  182.         { We saved this little nugget in DoTranslatorOpen. }
  183.     thisComponent := Component(storageHndl^^.self);  
  184.   IF thisComponent = NIL THEN CheckError(badComponentInstance);
  185.     { Remember what TopMapHndl is just before we open the resource file. }
  186.   saveTopMapHndl := HandlePtr(TopMapHndl)^;
  187.   compResFile := OpenComponentResFile(thisComponent);
  188.   CheckError(ResError);
  189.   IF compResFile = -1 THEN CheckError(resFNotFound);
  190.     { Get file spec for this component and close the resource file. }
  191.   result := FRefToFSSpec(compResFile,compFSSpec);
  192.     { If TopMapHndl changed when the component's resource file was opened,
  193.     then we opened a new access path to it, and therefore we should close it. }
  194.   IF saveTopMapHndl <> HandlePtr(TopMapHndl)^
  195.   THEN ignoreResult := CloseComponentResFile(compResFile);
  196.   CheckError(result);
  197.   
  198.   { We've got our FSSpecs; now use Apple events to make HyperCard go to the
  199.     stack in which this component resides and, once the stack is opened,
  200.     execute the custom 'translatestack' handler stored within the stack. }
  201.  
  202. { Create address descriptor for HyperCard (which is the current process) and then
  203.   create an "open documents" Apple event for sending to the current process. }
  204.   hyperPSN.highLongOfPSN := 0;
  205.   hyperPSN.lowLongOfPSN := kCurrentProcess;
  206.   CheckError(AECreateDesc(typeProcessSerialNumber,@hyperPSN,
  207.         SizeOf(hyperPSN),addressDesc));
  208.   CheckError(AECreateAppleEvent(kCoreEventClass,
  209.         kAEOpenDocuments,addressDesc,kAutoGenerateReturnID,
  210.         kAnyTransactionID,appleEvt));
  211. { Create list of documents to open and put it into the direct parameter. }
  212.   CheckError(AECreateList(NIL,0,FALSE,fileList));
  213.   CheckError(AEPutPtr(fileList,1,typeFSS,@compFSSpec,
  214.                                         SizeOf(compFSSpec)));
  215.   CheckError(AEPutParamDesc(appleEvt,keyDirectObject,fileList));
  216.   MyDisposeDesc(fileList); { AEPutParamDesc copied it into the Apple
  217.                                                   event, so we don't need this anymore. }
  218. { Send "open documents" Apple event to HyperCard. }
  219.   CheckError(AESend(appleEvt,replyEvt,
  220.                     kAENoReply + kAEDontRecord,
  221.                     kAENormalPriority,kAEDefaultTimeout,NIL,NIL));
  222.  
  223.   MyDisposeDesc(appleEvt);
  224.   MyDisposeDesc(replyEvt);{ desc should be null but can't hurt to make sure }
  225.  
  226.  
  227.  { Now create &send our custom scripting message, "translatestack", with parameters. }
  228. CheckError(AECreateAppleEvent(kOSASuite,
  229.                                                      kASSubroutineEvent,addressDesc,
  230.                                                      kAutoGenerateReturnID,
  231.                                                      kAnyTransactionID,appleEvt));
  232.   { Put message name into "subroutine name" parameter. }
  233.   msgStr := 'translatestack';
  234.   CheckError(AEPutParamPtr(appleEvt,keyASSubroutineName,
  235.                         typeChar,Ptr(ORD4(@msgStr)+1),Length(msgStr)));
  236.   { Create list of parameters to "translate stack" message. }
  237.   CheckError(AECreateList(NIL,0,FALSE,paramList));
  238.   CheckError(AEPutPtr(paramList,1,typeFSS,@stackFSSpec,
  239.                                       SizeOf(stackFSSpec)));
  240.   CheckError(AEPutPtr(paramList,2,typeFSS,Ptr(fileSpecPtr),
  241.                                       SizeOf(FSSpec)));
  242.   CheckError(AEPutPtr(paramList,3,typeType,@componentSubType,
  243.                                       SizeOf(componentSubType)));
  244.   CheckError(AEPutParamDesc(appleEvt,keyDirectObject,
  245.                                                  paramList));
  246.   MyDisposeDesc(paramList);
  247.   { Send subroutine event to HyperCard }
  248.   CheckError(AESend(appleEvt,replyEvt,
  249.                             kAENoReply+kAEDontRecord,
  250.                             kAENormalPriority,kAEDefaultTimeout,NIL,NIL));
  251.   CleanExit;
  252. END;
  253.  
  254. FUNCTION FRefToFSSpec(fRefNum:INTEGER; VAR spec:FSSpec):OSErr;
  255. { Convert a file reference number for an open access path to an FSSpec for the file.
  256.   Returns a file spec for a currently open file. }
  257. VAR fcbPBlock:  FCBPBRec;
  258.     nameStr:    Str255;
  259.     result:     INTEGER;
  260. BEGIN
  261.     WITH fcbPBlock DO BEGIN
  262.     ioCompletion := NIL;
  263.     ioNamePtr := @nameStr;
  264.     ioVRefNum := 0;
  265.     ioRefNum := fRefNum;
  266.     ioFCBIndx := 0;
  267.   END;
  268.   result := PBGetFCBInfo(@fcbPBlock,FALSE);
  269.   IF result = noErr THEN
  270.     BEGIN
  271.       spec.vRefNum := fcbPBlock.ioFCBVRefNum;
  272.       spec.parID := fcbPBlock.ioFCBParID;
  273.       spec.name := nameStr;
  274.     END;
  275.   FRefToFSSpec := result;
  276. END;
  277.  
  278. PROCEDURE MyDisposeDesc(VAR desc: AEDesc);
  279. { Dispose of an Apple event descriptor, if it's non-nil, and then set the dataHandle 
  280.   field to nil.  Prevents accidental double-disposals of handles. }
  281. VAR result: OSErr;
  282. BEGIN
  283.   IF desc.dataHandle <> NIL THEN result:=AEDisposeDesc(desc);
  284.   desc.dataHandle := NIL;
  285.   desc.descriptorType := typeNull;
  286. END;
  287.  
  288. PROCEDURE MyDisposHandle(VAR hndl: Handle);
  289. { Dispose of a handle, if it's non-nil, and then set it to nil.  Prevents accidental 
  290.   double-disposals of handles. }
  291. BEGIN
  292.   IF hndl = NIL THEN EXIT(MyDisposHandle);
  293.   DisposHandle(hndl);
  294.   hndl := NIL;
  295. END;
  296.  
  297. END.